home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Sample Code / Snippets / Files / SFGetFolder Pascal / GetFolder.p < prev    next >
Encoding:
Text File  |  1992-07-15  |  7.9 KB  |  235 lines  |  [TEXT/PJMM]
  1. { GetFolder Unit }
  2. { Greg Robbins 5/92  }
  3.  
  4. { Think Pascal 4.01; requires System 7 }
  5.  
  6. unit GetFolder;
  7. interface
  8.     uses
  9.         StandardFile, Script, Folders, Aliases; { MPW users need to use more }
  10.  
  11.     procedure StandardGetFolder (var theSFR: StandardFileReply);
  12.  
  13. implementation
  14.  
  15.     const
  16.         kSelectItem = 10; { select button }
  17.  
  18.         kDlgID = 250; { dialog resource number }
  19.  
  20.         kStrListID = 250;
  21.         kSelectStrNum = 1; { word 'Select: ' for button }
  22.         kDesktopStrNum = 2; { word 'Desktop' for button }
  23.  
  24.         kSelectKey = 's'; { command key equivalent for Select }
  25.  
  26.     type
  27.         UserDataRec = record { for standard file dialog hook }
  28.                 SFRPtr: ^StandardFileReply; { so the hook routine can look at what's in the reply record }
  29.                 oldSelectionFSSpec: FSSpec; { tracks the previous selection so we can tell when to change the button name }
  30.                 theDlgPtr: DialogPtr;
  31.             end;
  32.         UserDataRecPtr = ^UserDataRec;
  33.  
  34.     function GetSelectLabel: Str255;
  35.     begin
  36.         GetIndString(GetSelectLabel, kStrListID, kSelectStrNum);
  37.     end;
  38.  
  39.     function GetDesktopName: Str255;
  40.     begin
  41.         GetIndString(GetDesktopName, kStrListID, kDesktopStrNum);
  42.     end;
  43.  
  44.     { 'Select' button name needs to reflect the current selection }
  45.     { quoteFlag indicates that the button name should be in quotes, like Select “Foofile” }
  46.     procedure SetButtonName (theDlgPtr: DialogPtr; buttonID: Integer; buttonName: Str255; quoteFlag: Boolean);
  47.         var
  48.             buttonType: Integer;
  49.             buttonHandle: Handle;
  50.             buttonRect: Rect;
  51.             textWidth: Integer;
  52.             retCode: OSErr;
  53.     begin
  54.         GetDItem(theDlgPtr, buttonID, buttonType, buttonHandle, buttonRect);
  55.         if quoteFlag then
  56.             begin
  57.                 textWidth := (buttonRect.right - buttonRect.left) - (StringWidth(GetSelectLabel) + StringWidth('“ ”'));
  58.                 retCode := TruncString(textWidth, buttonName, smTruncMiddle);
  59.                 SetCTitle(ControlHandle(buttonHandle), Concat(GetSelectLabel, '“', buttonName, '”'))
  60.             end
  61.         else
  62.             begin
  63.                 textWidth := (buttonRect.right - buttonRect.left) - (StringWidth(GetSelectLabel) + CharWidth(' '));
  64.                 retCode := TruncString(textWidth, buttonName, smTruncMiddle);
  65.                 SetCTitle(ControlHandle(buttonHandle), Concat(GetSelectLabel, buttonName))
  66.             end;
  67.         ValidRect(buttonRect); { avoids flickering due to unnecessary redrawing }
  68.     end;
  69.  
  70.     { briefly highlight the button as feedback for key equivalents }
  71.     procedure FlashButton (theDlgPtr: DialogPtr; buttonID: Integer);
  72.         var
  73.             buttonType: Integer;
  74.             buttonHandle: Handle;
  75.             buttonRect: Rect;
  76.             finalTicks: LongInt;
  77.     begin
  78.         GetDItem(theDlgPtr, buttonID, buttonType, buttonHandle, buttonRect);
  79.         HiliteControl(ControlHandle(buttonHandle), inButton);
  80.         Delay(5, finalTicks);
  81.         HiliteControl(ControlHandle(buttonHandle), 0);
  82.     end;
  83.  
  84.     function SameFSSpec (itemFSSpec1, itemFSSpec2: FSSpec): Boolean;
  85.     begin
  86.         SameFSSpec := (itemFSSpec1.vRefNum = itemFSSpec2.vRefNum) and (itemFSSpec1.parID = itemFSSpec2.parID) and (itemFSSpec1.name = itemFSSpec2.name);
  87.     end;
  88.  
  89.     { dialog filter maps a key to the Select button }
  90.     function MyModalDlgFilter (theDlgPtr: DialogPtr; var myEvtRec: EventRecord; var item: Integer; myDataPtr: Ptr): Boolean;
  91.     begin
  92.         MyModalDlgFilter := FALSE;
  93.  
  94.     { make certain the proper dialog is showing }
  95.         if WindowPeek(theDlgPtr)^.refCon <> LongInt(sfMainDialogRefCon) then
  96.             Exit(MyModalDlgFilter);
  97.  
  98.     { check if select button hit }
  99.         if myEvtRec.what = keyDown then
  100.             if (BAND(cmdKey, myEvtRec.modifiers) <> 0) and (Char(BAND(myEvtRec.message, charCodeMask)) = kSelectKey) then
  101.                 begin
  102.                     item := kSelectItem;
  103.                     MyModalDlgFilter := TRUE;
  104.                     FlashButton(theDlgPtr, kSelectItem);
  105.                 end;
  106.     end;
  107.  
  108.     { filter out everything but folders from the dialog }
  109.     function MyCustomFileFilter (myCInfoPBPtr: CInfoPBPtr; myDataPtr: Ptr): Boolean;
  110.     begin
  111.         MyCustomFileFilter := not BTST(myCInfoPBPtr^.ioFlAttrib, 4);
  112.     end;
  113.  
  114.     { the hook routine maps the select button to Open and sets the Select button name }
  115.     function MyDlgHook (item: Integer; theDlgPtr: DialogPtr; myDataPtr: Ptr): Integer;
  116.         var
  117.             theUserDataRecPtr: UserDataRecPtr;
  118.             desktopVRefNum: Integer;
  119.             desktopDirID: LongInt;
  120.             tempFSSpec: FSSpec;
  121.             retCode: OSErr;
  122.     begin
  123.  
  124.     { make certain the proper dialog is showing }
  125.         if WindowPeek(theDlgPtr)^.refCon <> LongInt(sfMainDialogRefCon) then
  126.             begin
  127.                 MyDlgHook := item;
  128.                 Exit(MyDlgHook)
  129.             end;
  130.  
  131.         theUserDataRecPtr := UserDataRecPtr(myDataPtr);
  132.  
  133.         if item = kSelectItem then
  134.             item := sfItemOpenButton;
  135.  
  136.         MyDlgHook := item;
  137.  
  138.  
  139.     { find desktop folder }
  140.         retCode := FindFolder(theUserDataRecPtr^.SFRPtr^.sfFile.vRefNum, kDesktopFolderType, kDontCreateFolder, desktopVRefNum, desktopDirID);
  141.  
  142.     { change button if selection has changed or this is the first call }
  143.         if (not SameFSSpec(theUserDataRecPtr^.oldSelectionFSSpec, theUserDataRecPtr^.SFRPtr^.sfFile)) or (item = sfHookFirstCall) or (item = sfHookChangeSelection) or (item = sfHookRebuildList) then
  144.  
  145.             if theUserDataRecPtr^.SFRPtr^.sfFile.name <> '' then { selecting a folder }
  146.                 SetButtonName(theDlgPtr, kSelectItem, theUserDataRecPtr^.SFRPtr^.sfFile.name, TRUE)
  147.             else { no name selected }
  148.  
  149.         { is the desktop selected? }
  150.                 if (theUserDataRecPtr^.SFRPtr^.sfFile.vRefNum = desktopVRefNum) and (theUserDataRecPtr^.SFRPtr^.sfFile.parID = desktopDirID) then
  151.             { set button to Desktop }
  152.                     SetButtonName(theDlgPtr, kSelectItem, GetDesktopName, FALSE)
  153.  
  154.                 else { get parent directory's name }
  155.                     begin
  156.                         retCode := FSMakeFSSpec(theUserDataRecPtr^.SFRPtr^.sfFile.vRefNum, theUserDataRecPtr^.SFRPtr^.sfFile.parID, '', tempFSSpec);
  157.                         SetButtonName(theDlgPtr, kSelectItem, tempFSSpec.name, TRUE);
  158.                     end;
  159.  
  160.     { save the current selection as the old selection for comparison next time }
  161.  
  162.         if (item <> sfHookFirstCall) or (theUserDataRecPtr^.SFRPtr^.sfFile.name <> '') then
  163.             theUserDataRecPtr^.oldSelectionFSSpec := theUserDataRecPtr^.SFRPtr^.sfFile
  164.  
  165.         else { on first call, empty string won't set the button correctly, so invalidate oldSelection }
  166.             theUserDataRecPtr^.oldSelectionFSSpec.name := '_:_';
  167.  
  168.     end;
  169.  
  170.  
  171.     procedure StandardGetFolder (var theSFR: StandardFileReply);
  172.         var
  173.             mySFTypeList: SFTypeList;
  174.             thePoint: Point;
  175.             myData: UserDataRec;
  176.             tempFSSpec: FSSpec;
  177.             retCode: OSErr;
  178.             folderFlag, wasAliasedFlag: Boolean;
  179.             gestaltSFResponse: LongInt;
  180.     begin
  181.  
  182.     { use Gestalt to check for the CustomGetFile call }
  183.  
  184.         retCode := Gestalt(gestaltStandardFileAttr, gestaltSFResponse);
  185.         if (retCode <> noErr) or not BTST(gestaltSFResponse, gestaltStandardFile58) then
  186.             begin
  187.                 theSFR.sfGood := false;
  188.                 Exit(StandardGetFolder);
  189.             end;
  190.  
  191.         SetPt(thePoint, -1, -1); { center dialog }
  192.         theSFR.sfFile.name := ' '; { for initial button contents }
  193.  
  194.     { point the user data parameter at the reply record so we can get to it later }
  195.         myData.SFRPtr := @theSFR;
  196.  
  197.     { throw up the dialog }
  198.         CustomGetFile(@MyCustomFileFilter, 0, mySFTypeList, theSFR, kDlgID, thePoint, @MyDlgHook, @myModalDlgFilter, nil, nil, @myData);
  199.  
  200.         if theSFR.sfGood then { cancel not pressed and no fatal error occured }
  201.             begin
  202.         { if no name in the reply record file spec, use file spec of parent folder }
  203.                 if theSFR.sfFile.name = '' then
  204.                     begin
  205.             { make file spec for parent folder }
  206.                         retCode := FSMakeFSSpec(theSFR.sfFile.vRefNum, theSFR.sfFile.parID, '', tempFSSpec);
  207.                         if retCode = noErr then
  208.             { assign the parent folder's spec & check if it was for a volume }
  209.                             theSFR.sfFile := tempFSSpec
  210.                         else
  211.                             theSFR.sfGood := FALSE; { no name to return, forget it }
  212.                     end;
  213.  
  214.         { if there is now a name in the file spec, check if it is a folder or a volume }
  215.                 if theSFR.sfFile.name <> '' then
  216.                     begin
  217.                         if theSFR.sfFile.parID = 1 then
  218.                             begin
  219.                                 theSFR.sfIsVolume := TRUE;
  220.                                 theSFR.sfIsFolder := FALSE { it would be reasonable to make this true, too }
  221.                             end;
  222.  
  223.             { we have a valid FSSpec, now let's make sure it's not for an alias file }
  224.                         retCode := ResolveAliasFile(theSFR.sfFile, TRUE, folderFlag, wasAliasedFlag);
  225.                         if retCode <> noErr then
  226.                             theSFR.sfGood := false;
  227.  
  228.             { did the alias file resolve to a folder? }
  229.                         if folderFlag and not theSFR.sfIsVolume then
  230.                             theSFR.sfIsFolder := TRUE;
  231.                     end;
  232.             end;
  233.     end;
  234.  
  235. end.